home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Serious Software / Cherwell Scientific Demos / pro Fit / pro Fit 5.0 demo (fpu).sea / pro Fit 5.0 demo (fpu) / Functions & Programs / Fractals < prev    next >
Text File  |  1996-06-02  |  5KB  |  181 lines
  1. { These are two programs that show how to draw into drawing windows. }
  2. { To them, choose "Add to Menu" from the Misc menu to compile them }
  3. { Then run either of them by choosing "FractalPythagoras" or "FractalClover" }
  4. { from the Misc menu. }
  5. { Warning: Running these programs (especially FractalPythagoras) can take several }
  6. { minutes on slower Macs. To interrupt it, type cmd-. }
  7.  
  8. { Both programs draw some well-known fractal figures }
  9.  
  10. {#########################################################################################}
  11.  
  12. program FractalPythagoras;
  13.  
  14. const axStart = 150;
  15.       ayStart = 300;
  16.       bxStart = 150;
  17.       byStart = 200;
  18.  
  19. var maxNrIterations;
  20.     angle, angleDeg;
  21.     iteration;
  22.     sinAngle, cosAngle;
  23.     minSize, minSizeSqr;
  24.     filled;
  25.  
  26. procedure Initialize;
  27. begin
  28.   maxNrIterations := 1000;
  29.   angleDeg := 30;
  30.   minSize := 6;
  31.   filled := true;
  32. end;
  33.  
  34. function RandomizeColor(color);
  35. const variation = 10000;
  36. begin
  37.   color := color + (Random-0.5)*variation;
  38.   if color < 0 then color := color+variation
  39.   else if color > 65535 then color := color - variation;
  40.   RandomizeColor := color;
  41. end;
  42.  
  43.  
  44. procedure DoOneIteration(ax, ay, bx, by, r, g, b);
  45.  var cx, cy, a1x, a1y, b1x, b1y, a2x, a2y, b2x, b2y;
  46.      rx, ry;
  47. begin
  48.   iteration := iteration +1;
  49.   rx := bx-ax; ry := by-ay;
  50.   if sqr(rx) + sqr(ry) < minSizeSqr then exit;
  51.   cx := sqr(cosAngle) * rx - sinAngle*cosAngle*ry + ax;
  52.   cy := sqr(cosAngle) * ry + sinAngle*cosAngle*rx + ay;
  53.   a1x := cx + (cy-by);
  54.   a1y := cy + (bx-cx);
  55.   b1x := bx + (cy-by);
  56.   b1y := by + (bx-cx);
  57.   a2x := ax - (cy-ay);
  58.   a2y := ay - (ax-cx);
  59.   b2x := cx - (cy-ay);
  60.   b2y := cy - (ax-cx);
  61.   r := RandomizeColor(r);
  62.   g := RandomizeColor(g);
  63.   b := RandomizeColor(b);
  64.   if filled then begin
  65.     SetFillColor(r,g,b);
  66.     SetFillPattern(2);
  67.   end else SetLineColor(r,g,b);
  68.   OpenPoly(0,0);
  69.   MoveTo(cx, cy); LineTo(ax, ay);
  70.   LineTo(a2x, a2y); LineTo(b2x, b2y);
  71.   LineTo(cx, cy); LineTo(a1x, a1y);
  72.   LineTo(b1x, b1y); LineTo(bx, by);
  73.   LineTo(cx, cy);
  74.   ClosePoly;
  75.   if filled then begin
  76.     OpenPoly(0,0);
  77.     MoveTo(cx, cy); LineTo(ax, ay);
  78.     LineTo(bx, by); LineTo(cx, cy);
  79.     ClosePoly;
  80.   end;
  81.   if iteration < maxNrIterations then
  82.   begin
  83.     DoOneIteration(a1x, a1y, b1x, b1y, r, g, b);
  84.     DoOneIteration(a2x, a2y, b2x, b2y, r, g, b);
  85.   end;
  86.   iteration := iteration -1;
  87. end;
  88.  
  89. begin
  90.  iteration := 0;
  91.  Input('Angle [deg]: ', angleDeg, 'minimum size: ', minSize,
  92.        'max iterations', maxNrIterations, '$XFilled', filled);
  93.  angle := AngleDeg * π/180;
  94.  minSizeSqr := sqr(minSize);
  95.  sinAngle := sin(angle);
  96.  cosAngle := cos(angle);
  97.  setLineStyle(0.25,1);
  98.  DisableDrawingUpdates;
  99.  if not filled then SetFillPattern(0);
  100.  DoOneIteration(axStart, ayStart, bxStart, byStart, Random*65000, Random*65000, Random*65000);
  101.  SetFillPattern(0); SetFillColor(0,0,0); SetLineColor(0,0,0);  { reset these values }
  102. end;
  103.  
  104. {#########################################################################################}
  105.  
  106. program FractalClover;
  107.  
  108. var
  109.   depth, maxDepth: integer;
  110.   factorA, factorB;
  111.   symmetry, symmetryFactor;
  112.  
  113.   procedure MyLineTo(x, y);
  114.   begin
  115.     if x < -1000 then x := -1000
  116.     else if x > 1000 then x := 1000;
  117.     if y < -1000 then y := -1000
  118.     else if y > 1000 then y := 1000;
  119.     LineTo(x,y);
  120.   end;
  121.  
  122.   procedure DrawOneSegment(x1, y1, x2, y2);
  123.    { draws the line segment between x1/y1 and x2/y2 }
  124.   var xA, yA, xB, yB, xC, yC;
  125.       dx, dy;
  126.   begin
  127.     depth := depth+1;
  128.     dx := x2-x1; dy := y2-y1;
  129.     xA := x1 + symmetryFactor*dx/2;
  130.     yA := y1 + symmetryFactor*dy/2;
  131.     xB := x1 + dx*symmetryFactor - factorA*dy;
  132.     yB := y1 + dy*symmetryFactor + factorB*dx;
  133.     xC := x2 - symmetryFactor*dx/2;
  134.     yC := y2 - symmetryFactor*dy/2;
  135.     if depth >= maxDepth then
  136.     begin
  137.       MyLineTo(xA, yA);
  138.       MyLineTo(xB, yB);
  139.       MyLineTo(xC, yC);
  140.       MyLineTo(x2, y2);
  141.     end
  142.     else
  143.     begin
  144.       DrawOneSegment(x1, y1, xA, yA);
  145.       DrawOneSegment(xA, yA, xB, yB);
  146.       DrawOneSegment(xB, yB, xC, yC);
  147.       DrawOneSegment(xC, yC, x2, y2);
  148.     end;
  149.     depth := depth-1;
  150.   end;
  151.  
  152. procedure Initialize;
  153. begin
  154.   factorA := 1/3;
  155.   factorB := 1/3;
  156.   symmetry := 0;
  157.   maxDepth := 5;
  158. end;
  159.  
  160.  
  161. begin
  162.   depth := 0;
  163.   Input('iterations (1..5)', maxDepth,
  164.         'factor A (-1..1)', factorA,
  165.         'factor B (-1..1)', factorB,
  166.         'symmetry (-0.999...0.999)', symmetry);
  167.   if maxDepth < 1 then maxDepth := 1
  168.   else if maxDepth > 5 then maxDepth := 5;
  169.   if factorA < -1 then factorA := -1
  170.   else if factorA > 1 then factorA := 1;
  171.   if factorB < -1 then factorB := -1
  172.   else if factorB > 1 then factorB := 1;
  173.   if symmetry < -0.999 then symmetry := -0.999
  174.   else if symmetry > 0.999 then symmetry := 0.999;
  175.   symmetryFactor := symmetry / 2 + 0.5;
  176.         
  177.   MoveTo(10, 100);
  178.   OpenPoly(0, false);
  179.   DrawOneSegment(10, 100, 400, 100);
  180.   ClosePoly;
  181. end;